home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / random12.zip / RANDOM12.PRG < prev   
Text File  |  1992-08-08  |  5KB  |  108 lines
  1. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. * Program..: RANDOM12.PRG & rnd() function                                    *
  3. * Author...: Ken Rockson                                                      *
  4. * Date.....: 05-28-1990                                                       *
  5. * Copyright: This program is hereby donated to the public domain.             *
  6. *                                                                             *
  7. * Notes....: This function generates a different psuedo-random number between *
  8. *            1 and the number passed it for each iteration.  It seeds with    *
  9. *            the internal clock.  It is based on Allen Jackson's RANDOM.PRG,  *
  10. *            but uses recursive non-linear feedback of the resulting numbers  *
  11. *            to create unique, non-repeating numbers with a fairly smooth     *
  12. *            distribution (within 0.8%). I've also included a benchmark       *
  13. *            routine so that you can play with it and maybe improve it. Also  *
  14. *            included is the original RANDOM.PRG. I don't think Allen Jackson *
  15. *            will mind. If you know him, please send this to him.             *
  16. *                                                                             *
  17. *            If you use have any questions or comments, or make improvements, *
  18. *            call or write me at:                                             *
  19. *                                                                             *
  20. *            The Animation Station                                            *
  21. *            (416) 443-8670 (voice)                                           *
  22. *            150 Graydon Hall Drive, Suite 2602                               *
  23. *            Don Mills, Ontario, Canada M3A 3B3                               *
  24. *                                                                             *
  25. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  26.  
  27. * Here's the info from the top of Allen Jackson's program:
  28.  
  29. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  30. * Program..: RANDOM.PRG v 1.1                                                 *
  31. * Author...: Allen Jackson                                                    *
  32. * Date.....: 05-28-1990                                                       *
  33. * Copyright: This program is hereby donated to the public domain.             *
  34. *                                                                             *
  35. * Notes....: This program generates a different psuedo-random number between  *
  36. *            0 and 1 for each iteration.  It generates a different number     *
  37. *            each second because the seed used is based on the internal       *
  38. *            clock.  Originally, I had implemented it as a function, but      *
  39. *            some dBASE dialects could not handle it.  Implementation as a    *
  40. *            function is left to the user.                                    *
  41. *                                                                             *
  42. *            I know there are ways to generate the numbers quicker, but I've  *
  43. *            not yet found a way other than this that works in EVERY dialect. *
  44. *            For example, FoxPro now includes a RAND() function that is far   *
  45. *            superior to this kludge.                                         *
  46. *                                                                             *
  47. *            If you use this program and have any questions or comments,      *
  48. *            drop me a note at:                                               *
  49. *                                                                             *
  50. *                             MCS Consulting                                  *
  51. *                             8125 Starwood Court                             *
  52. *                             Baton Rouge, LA  70820                          *
  53. *                                                                             *
  54. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  55.  
  56. declare i[10]
  57. afill(i,0)
  58. lastnum=0
  59. lastask=0
  60. DO WHILE .T.
  61. consec=0
  62. lc=0
  63. for x=1 to 6000
  64.    ln=lastnum
  65.    y=rnd(10)                    && Randomly draw a number from 1 to 10.
  66.    i[y]=i[y]+1                  && Count number of 1's, 2's, etc. drawn.
  67.    if y=ln
  68.      lc=lc+1
  69.      if lc>consec               && Count consecutive numbers.
  70.        consec=lc
  71.      endif
  72.    endif
  73.  next x
  74.  ?
  75.  it=0
  76.  for x=1 to 10                  && Display running count of 1's, 2's, etc.
  77.    ?? str(i[x],7)
  78.    it=it+i[x]
  79.  next x
  80.  ?
  81.  for x=1 to 10                  && Display percentage content of 1's, etc.
  82.    ?? str(i[x]/it*100,7,2)
  83.  next x
  84.  ?? str(consec,4)               && Display number of consecutive numbers
  85. ENDDO                           && drawn on this pass.                   
  86. RETURN
  87.  
  88.  
  89.  
  90. function rnd
  91.  
  92. * Draw a number from one to (oneto).
  93.  
  94. parameter oneto
  95.  
  96.    * If this is a repeat request for a certain range, seed with the last
  97.    * number drawn. Otherwise, seed with hundreths of a second.
  98.  
  99.    if lastask=oneto
  100.      lastnum=(mOD(lastnum*lastnum*7137421+21132487, 10000000)/ 10000000*oneto)+1
  101.    else
  102.      lastnum=(mOD(seconds()*7137421+21132487,10000000)/10000000*oneto)+1
  103.    endif
  104.    lastask=oneto
  105.    return lastnum
  106.  
  107.  
  108.